perm filename XXX.SAI[X,ALS] blob sn#090766 filedate 1974-03-12 generic text, type T, neo UTF8
00010	BEGIN "XRUN"
00020	DEFINE ⊂="COMMENT";
00030	
00040	⊂ This program runs another program, BXX, as a separate job and produces
00050	an XGP plot of formant data from the specified file. This program may
00060	be executed directly, in which case it requests info from the TTY, or it
00070	be called into being as a separate job and passed a number specifying
00080	the file to be used. In this second case this program automatically
00090	kills its job on completion;
00100	
00110	DEFINE ⊃="⊂";
00120	DEFINE CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00130	  INTEGER I,J,K,L,M,X,Y,LX,LY,DX,DY,CHAN5,CHAN1,EOF,BRCHR,DOTS,SMOO,
00140	    SCALE,HT,PP,POINTP,FLAG,MUTE,NUM;
00145	INTEGER ARRAY X1,XX2,Y1,YY2[0:10];
00150	  STRING FILEP,FILEN,READ,MEMO; BOOLEAN ER;
00160	  INTEGER ARRAY SAVE,JHSAVE[0:6];
00170	  INTEGER ARRAY LFILE[0:127];
00180	  INTEGER ARRAY NEW[0:511];
00190	  INTEGER ARRAY DPYBUF[0:4096];
00200	INTEGER A1,A2,A3;
00210	LABEL STARTP;
00220	INTEGER DATE,TIME;
00230	DEFINE GETIME="BEGIN DATE←CALL(0,""DATE""); TIME←CALL(0,""TIMER"")%60; END;";
00240	PRELOAD_WITH "JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG",
00250		"SEP","OCT","NOV","DEC";
00260	STRING ARRAY MONTHS[0:11];
00261	
00262	PROCEDURE MEDIAN;
00263	
00264	BEGIN
00265	
00266	IF (Y1[I]>YY2[I])∧(Y>YY2[I]) THEN BEGIN
00267	    IF Y1[I]>Y THEN YY2[I]←Y ELSE YY2[I]←Y1[I];END;
00268	
00269	IF (Y1[I]<YY2[I])∧(Y<YY2[I])  THEN BEGIN
00270	    IF Y1[I]<Y THEN YY2[I]←Y ELSE YY2[I]←Y1[I]; END;
00271	
00272	Y1[I]←YY2[I]; YY2[I]←Y; Y←Y1[I]; X1[I]←XX2[I]; XX2[I]←X; X←X1[I];
00273	END;
00274	
00280	INTERNAL STRING PROCEDURE DATIM;
00290	BEGIN
00300	INTEGER DAY,YR,HRS,MIN,SEC;
00310	DAY←(DATE MOD 31)+1;DATE←DATE%31;
00320	YR←1964+DATE%12; SEC←TIME MOD 60;
00330	TIME←TIME%60; MIN←TIME MOD 60; HRS←TIME%60;
00340	SETFORMAT(-2,0);
00350	RETURN(CVS(DAY)&"-"&MONTHS[DATE MOD 12]&
00360	   "-"&CVS(YR)&"   "&CVS(HRS)&CVS(MIN)&":"&CVS(SEC));
00370	END;
00380	
00390	INTERNAL STRING PROCEDURE WTIM;
00400	BEGIN
00410	DATE←SAVE[2] LAND '7777; TIME←LDB(POINT(11,SAVE[2],23))*60;
00420	RETURN(DATIM);
00430	END;
00440	
00450	INTERNAL STRING PROCEDURE DATIME;
00460	BEGIN
00470	GETIME;
00480	RETURN(DATIM);
00490	END;
00500	
00510	
00520	⊂ Allow 1140 units on a line corresponding to 76 charactters @15 units,
00530	   380 segments @ 3 and 48640 samples @ 3/128 unit, or 2.432 seconds;
00540	
00550	
00560	PROCEDURE XPLOT;
00570	BEGIN "XPLOT"
00580	REQUIRE "SXF.REL[SAI,NJM]" LIBRARY;
00590	REQUIRE "XM.REL[FEB,NJM]" LIBRARY;
00600	REQUIRE "SIO.REL[SAI,NJM]" LIBRARY;
00610	EXTERNAL FORTRAN PROCEDURE XSET;
00620	EXTERNAL FORTRAN PROCEDURE XRVEC;
00630	EXTERNAL FORTRAN PROCEDURE XVEC;
00640	EXTERNAL FORTRAN PROCEDURE XIVEC;
00650	EXTERNAL FORTRAN PROCEDURE XIRVEC;
00660	EXTERNAL FORTRAN PROCEDURE XLINE;
00670	EXTERNAL FORTRAN PROCEDURE VERTAX;
00680	EXTERNAL FORTRAN PROCEDURE SWT25;
00690	EXTERNAL FORTRAN PROCEDURE PTX1;
00700	EXTERNAL FORTRAN PROCEDURE XOUT;
00710	EXTERNAL FORTRAN PROCEDURE XFIN;
00720	INTERNAL STRING XSTR,XSTR1,XSTR2,XSTRH;
00730	INTEGER IX,IX2,IY,XREF,YREF,X2,Y2,XSAVE,XCUT;
00740	INTEGER MIN,MAX,ERR;
00750	MIN←0;
00760	MAX←3000;
00770	XREF←400;
00780	YREF←580;
00790	⊂ HT←700;	⊂ Allowing 5 inches for 5000 hertz;
00800	XSET;
00810	
00820	IX←XREF-90; IY←YREF+HT+40; XSTR←"Hertz"; SWT25(IX,IY);
00830	VERTAX(MIN,MAX,XREF,YREF,HT);
00840	IX←XREF-150;
00850	XSTR←"     Null"; IY←YREF-405; SWT25(IX,IY);
00860	XSTR←"  Silence"; IY←YREF-405+30; SWT25(IX,IY);
00870	XSTR←"Fricative"; IY←YREF-405+60; SWT25(IX,IY);
00880	XSTR←" Voi.Fri."; IY←YREF-405+90; SWT25(IX,IY);
00890	XSTR←" Nas.Vow."; IY←YREF-405+120; SWT25(IX,IY);
00900	XSTR←"   Voiced"; IY←YREF-405+150; SWT25(IX,IY);
00910	IX←XREF-166;
00920	XSTR←"Continuant"; IY←YREF-75; SWT25(IX,IY);
00930	XSTR←" Transient";  IY←YREF-105; SWT25(IX,IY);
00940	XSTR←"    Steady";  IY←YREF-150; SWT25(IX,IY);
00945	XSTR←"  Drifting";  IY←YREF-180; SWT25(IX,IY);
00950	XSTR←"    Moving";  IY←YREF-210; SWT25(IX,IY);
00960	
00970	XOUT(XREF-8);
00980	XSAVE←0;
00990	
01000	CLOSE(CHAN5); OPEN(CHAN5,"DSK",'10,2,0,0,0,EOF);
01010	LOOKUP(CHAN5,FILEP,ERR);
01020	FILEINFO(SAVE);
01030	IF ERR THEN OUTSTR("FILE "&FILEP&"  NOT FOUND"&CRLF);
01040	ARRYIN(CHAN5,LFILE[0],'200);
01050	
01060	XSTR←""; FOR I←10 STEP 1 UNTIL 20 DO XSTR←XSTR&CVXSTR(LFILE[I]);
01070	IX←XREF; IY←YREF-480; SWT25(IX,IY);
01080	 READ←WTIM; SETFORMAT(1,0);
01090	
01100	XSTR←"The first "&CVS(NUM)&" formants in parameter file "
01110	     &FILEP&" (created "&READ&")";
01120	IX←XREF; IY← YREF+870; SWT25(IX,IY);
01130	IF SMOO=0 THEN XSTR←"Mute level at "&CVS(MUTE)&". "&MEMO ELSE
01135	  XSTR←"Mute level at "&CVS(MUTE)&" with medial smoothing. "&MEMO;
01140	IX←XREF+100; IY←YREF+840; SWT25(IX,IY);
01150	XSTR←"With parameters from the time domain data.";
01160	IX←XREF; IY←YREF+810; SWT25(IX,IY);
01170	XSTR←"A.I. Laboratory, Stanford University.   "&DATIME;
01180	IX←XREF+200; IY←YREF+780; SWT25(IX,IY);
01190	
01200	FOR I←21 STEP 1 UNTIL 127 DO BEGIN "PONY"
01210	  IF LFILE[I]=0 THEN DONE;
01220	  L←LFILE[I] LAND '777760000000;
01230	  J←LDB(POINT(14,LFILE[I],27))-1; K←LDB(POINT(8,LFILE[I],35))-1;
01240	
01250	  X←J*128%SCALE+K*64%SCALE-8;
01260	  IF X<XSAVE+16 THEN X←XSAVE+16; XSAVE←X;
01270	  IX←XREF+X; IY←YREF-45; XSTR←(READ←CVSTR(L))[1 TO 1]; SWT25(IX,IY);
01280	  IF (XSTR←READ[2 TO 2])≠"" THEN BEGIN
01290	    IY←YREF-70; SWT25(IX,IY); END;
01300	
01310	  IX←XREF+J*128%SCALE; IX2←IX+K*128%SCALE;
01320	  XLINE(IX,YREF-20,IX,YREF);
01330	  XLINE(IX,YREF,IX2,YREF);
01340	  XLINE(IX,YREF-1,IX2,YREF-1);
01350	  XLINE(IX,YREF-2,IX2,YREF-2);
01360	  XLINE(IX2,YREF,IX2, YREF-20);
01370	
01380	  END "PONY";
01390	OUTSTR("Text,");
01400	FOR I←0 STEP 20000%SCALE UNTIL IX DO BEGIN "TIME"
01410	  XLINE(XREF+I,YREF,XREF+I,YREF+20);
01412	  IF (I≠0)∧(DOTS=0) THEN FOR J←HT%6 STEP HT%6 UNTIL HT DO BEGIN
01413	    XLINE(XREF+I-5,YREF+J,XREF+I+5,YREF+J);
01414	    XLINE(XREF+I,YREF+J-5,XREF+I,YREF+J+5);  END;
01420	  FOR K←1 STEP 1 UNTIL 9 DO BEGIN
01430	    IX←XREF+I+K*2000%SCALE; IF IX>IX2 THEN DONE "TIME";
01440	    XLINE(IX,YREF,IX,YREF+10); END;
01442	    IF DOTS=0 THEN FOR J←HT%6 STEP HT%6 UNTIL HT DO BEGIN
01443	      XLINE(IX-2,YREF+J,IX+2,YREF+J); XLINE(IX,YREF+J-2,IX,YREF+J+2); END;
01450	  END "TIME";
01460	
01470	XCUT←IX2+200;
01480	
01490	
01500	FOR I←0 STEP 1 UNTIL 5 DO
01505	  SAVE[I]←X1[I]←XX2[I]←Y1[I]←YY2[I]←0;
01510	XSAVE←0;
01520	JHSAVE[0]←XREF;
01530	JHSAVE[1]←YREF-92;
01540	JHSAVE[2]←YREF-197;
01550	JHSAVE[3]←YREF-392;
01560	WHILE EOF=0 DO BEGIN "XDATIN"
01570	  FOR I←0 STEP 1 UNTIL 511 DO NEW[I]←0;
01580	  ARRYIN(CHAN5,NEW[0],512);
01590	    IF NEW[0]=0 THEN DONE "XDATIN";
01600	
01610	  FOR I←1 STEP 1 UNTIL NUM DO BEGIN "XPLO"
01620	    LY←SAVE[I]; LX←SAVE[0]; XIVEC(XREF+LX,YREF+LY);
01630	    FOR J←0 STEP 8 UNTIL 504 DO BEGIN
01640	      IF NEW[J]=0 THEN DONE;
01650	      X←(NEW[J] LSH -15)%SCALE;
01660	        ⊂ Allowing 32 samples per unit or 3.125 inches per second;
01670	        ⊂ This corresponds to 512 samples (32*16) per character;
01680	
01690	      POINTP←POINT(9,NEW[J+1],-1);
01700	      FOR K←1 STEP 1 UNTIL I DO IBP(POINTP);
01710	      Y← LDB(POINTP)*5*HT%1536; ⊂ 3 inches for 3000 hertz default;
01720	
01725	      IF SMOO=1 THEN MEDIAN;	⊂ Replaces Y and X by previous values with medial smoothing;
01730	      IF Y=0 THEN Y←LY;
01740	      DX←X-LX; LX←X; DY←Y-LY; LY←Y;
01750	      IF (LDB(POINT(9,NEW[J+2],26)) < MUTE)∨(DX<3)
01760	        THEN XIRVEC(DX,DY) ELSE  XRVEC(DX,DY);
01770	      END;
01780	    SAVE[I]←LY;
01790	    END "XPLO";
01800	  SAVE[0]←LX;
01810	
01820	  FOR I←1 STEP 1 UNTIL 3 DO BEGIN "JH"
01830	    LX←JHSAVE[0]; LY←JHSAVE[I];XIVEC(LX,LY);
01840	    FOR J←0 STEP 8 UNTIL 504 DO BEGIN
01845	      IF NEW[J]=0 THEN DONE;
01850	      X←(NEW[J] LSH -15)%SCALE+XREF;
01870	
01880	      CASE I OF BEGIN
01890	        Y← LDB(POINT(9,NEW[J+7],17))*30+YREF-62; ⊂ Dummy since no 0;
01900	        Y← LDB(POINT(9,NEW[J+7],17))*30+YREF-92;
01910	        Y← LDB(POINT(9,NEW[J+7],26))*30+YREF-197;
01920	        Y← LDB(POINT(9,NEW[J+7],35))*30+YREF-392;
01930	        END;
01940	      XVEC(X,LY); XVEC(X,Y); LX←X; LY←Y;
01950	      END;
01960	    JHSAVE[I]←LY;
01970	    END "JH"; JHSAVE[0]←LX;
01980	
01990	  IF SAVE[0]=XSAVE THEN DONE "XDATIN";  XSAVE←SAVE[0];
02000	  XOUT(SAVE[0]-20); OUTSTR(CVS(SAVE[0])&",");
02010	  END "XDATIN";
02020	CLOSE(CHAN5);
02030	XOUT(XCUT); OUTSTR(CVS(XCUT)&CRLF);
02040	IF XCUT<2200 THEN BEGIN XCUT←2200; XOUT(XCUT); END;
02050	
02060	XFIN;
02070	END "XPLOT";
02080	
     

00010	CHAN1←1; CHAN5←5;
00015	MUTE←60; NUM←3; SCALE←20; HT←600; DOTS←SMOO←0; MEMO←"";
00017	
00018	
00020	STDBRK(1);
00030	STARTP:
00050	CLOSE(CHAN1); OPEN(CHAN1,"DSK",0,1,0,70,BRCHR,EOF);
00060	LOOKUP(CHAN1,"NUMBER.TMP",ER);
00070	IF ER THEN BEGIN
00072	OUTSTR("This program graphs formants on the XGP from a parameter file."&CRLF);
00074	OUTSTR("The following set-up commands (with CR) "
00076	  &"may be given:"&CRLF);
00078	OUTSTR("	M#	set MUTE level to # (default value 60)"&CRLF&
00080	"	R#	set horizontal scale reduction factor (default value 20)"&CRLF&
00081	"	V#	set vertical size in 1/200 inch. (default value 600)"&CRLF&
00082	"	D	delete scale points (default condition with points)"&CRLF&
00084	"	S	medial smooth (default condition with no smoothing)"&CRLF&
00086	"	C	typed comment to CR (60 char. max.) will appear on graph"&CRLF&
00088	"	N#	set number of formants (default value 3)."&CRLF);
00090	OUTSTR("A number (without letter) terminates condition-setting and specifies the file to use."
00092	      &CRLF&TB&"A CR only calls for file # 1."&CRLF&LF);
00094	SETFORMAT(1,0); FLAG←0; X←0;
00096	WHILE TRUE DO BEGIN "TYPE" OUTSTR("Type command  "); READ←INCHWL;
00098	IF READ[1 TO 1]="M" THEN BEGIN MUTE←CVD(READ[2 TO 4]);CONTINUE "TYPE";END;
00100	IF READ[1 TO 1]="R" THEN BEGIN SCALE←CVD(READ[2 TO 4]);CONTINUE "TYPE";END;
00101	IF READ[1 TO 1]="V" THEN BEGIN HT←CVD(READ[2 TO 4]);CONTINUE "TYPE"; END;
00102	IF READ[1 TO 1]="S" THEN BEGIN SMOO←1; CONTINUE "TYPE";END;
00104	IF READ[1 TO 1]="D" THEN BEGIN DOTS←1;CONTINUE "TYPE";END;
00106	IF READ[1 TO 1]="C" THEN BEGIN MEMO←READ[2 TO 61];CONTINUE "TYPE";END;
00170	IF READ[1 TO 1]="N" THEN BEGIN NUM←CVD(READ[2 TO 2]);CONTINUE "TYPE";END;
00180	DONE; END "TYPE";
00190	IF READ="" THEN PP←1 ELSE PP←CVD(READ);
00200	END ELSE BEGIN
00210	  PP←CVD(INPUT(CHAN1,1));
00220	  CLOSE(CHAN1);
00230	  END;
00240	
00250	FILEP←"SEG"&CVS(PP)&".SYN[2,JH]";
00260	
00270	XPLOT;
00280	PTOSTR(0,"RU BXX[FEB,NJM]"&CRLF);
00300	
00310	END "XRUN";